!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! SUBROUTINE PSQP_WRAP          ALL SYSTEMS                 2013/02/06
! PURPOSE :
! WRAPPING SUBROUTINE FOR PSQP.
!
! PARAMETERS :
!  II  NF  NUMBER OF VARIABLES.
!  II  NC  NUMBER OF LINEAR CONSTRAINTS.
!  RI  X(NF)  VECTOR OF VARIABLES.
!  II  IX(NF)  VECTOR CONTAINING TYPES OF BOUNDS. IX(I)=0-VARIABLE
!         X(I) IS UNBOUNDED. IX(I)=1-LOVER BOUND XL(I).LE.X(I).
!         IX(I)=2-UPPER BOUND X(I).LE.XU(I). IX(I)=3-TWO SIDE BOUND
!         XL(I).LE.X(I).LE.XU(I). IX(I)=5-VARIABLE X(I) IS FIXED.
!  RI  XL(NF)  VECTOR CONTAINING LOWER BOUNDS FOR VARIABLES.
!  RI  XU(NF)  VECTOR CONTAINING UPPER BOUNDS FOR VARIABLES.
!  RI  CF(NC+1)  VECTOR CONTAINING VALUES OF THE CONSTRAINT FUNCTIONS.
!  II  IC(NC)  VECTOR CONTAINING TYPES OF CONSTRAINTS.
!         IC(KC)=0-CONSTRAINT CF(KC) IS NOT USED. IC(KC)=1-LOVER
!         CONSTRAINT CL(KC).LE.CF(KC). IC(KC)=2-UPPER CONSTRAINT
!         CF(KC).LE.CU(KC). IC(KC)=3-TWO SIDE CONSTRAINT
!         CL(KC).LE.CF(KC).LE.CU(KC). IC(KC)=5-EQUALITY CONSTRAINT
!         CF(KC).EQ.CL(KC).
!  RI  CL(NC)  VECTOR CONTAINING LOWER BOUNDS FOR CONSTRAINT FUNCTIONS.
!  RI  CU(NC)  VECTOR CONTAINING UPPER BOUNDS FOR CONSTRAINT FUNCTIONS.
!  II  MIT  MAXIMUN NUMBER OF ITERATIONS.
!  II  MFV  MAXIMUN NUMBER OF FUNCTION EVALUATIONS.
!  II  MET  VARIABLE METRIC UPDATE USED. MET=1-THE BFGS UPDATE.
!         MET=2-THE HOSHINO UPDATE.
!  II  MEC  CORRECTION IF THE NEGATIVE CURVATURE OCCURS.
!         MEC=1-CORRECTION SUPPRESSED. MEC=2-POWELL'S CORRECTION.
!  RI  XMAX  MAXIMUM STEPSIZE.
!  RI  TOLX  TOLERANCE FOR CHANGE OF VARIABLES.
!  RI  TOLC  TOLERANCE FOR CONSTRAINT VIOLATIONS.
!  RI  TOLG  TOLERANCE FOR THE GRADIENT OF THE LAGRANGIAN FUNCTION.
!  RI  RPF  PENALTY COEFFICIENT.
!  RO  F  VALUE OF THE OBJECTIVE FUNCTION.
!  RO  GMAX  MAXIMUM PARTIAL DERIVATIVE OF THE LAGRANGIAN FUNCTION.
!  RO  CMAX  MAXIMUM CONSTRAINT VIOLATION.
!  II  IPRNT  PRINT SPECIFICATION. IPRNT=0-NO PRINT.
!         ABS(IPRNT)=1-PRINT OF FINAL RESULTS.
!         ABS(IPRNT)=2-PRINT OF FINAL RESULTS AND ITERATIONS.
!         IPRNT>0-BASIC FINAL RESULTS. IPRNT<0-EXTENDED FINAL
!         RESULTS.
!  II  IOUT  PRINT OUTPUT UNIT NUMBER.
!  II  IFILE PRINT OUTPUT FILENAME.
!  IO  ITERM  VARIABLE THAT INDICATES THE CAUSE OF TERMINATION.
!         ITERM=1-IF ABS(X-XO) WAS LESS THAN OR EQUAL TO TOLX IN
!                   MTESX (USUALLY TWO) SUBSEQUEBT ITERATIONS.
!         ITERM=2-IF ABS(F-FO) WAS LESS THAN OR EQUAL TO TOLF IN
!                   MTESF (USUALLY TWO) SUBSEQUEBT ITERATIONS.
!         ITERM=3-IF F IS LESS THAN OR EQUAL TO TOLB.
!         ITERM=4-IF GMAX IS LESS THAN OR EQUAL TO TOLG.
!         ITERM=11-IF NIT EXCEEDED MIT. ITERM=12-IF NFV EXCEEDED MFV.
!         ITERM=13-IF NFG EXCEEDED MFG. ITERM<0-IF THE METHOD FAILED.
!         IF ITERM=-6, THEN THE TERMINATION CRITERION HAS NOT BEEN
!         SATISFIED, BUT THE POINT OBTAINED IF USUALLY ACCEPTABLE.
!
! VARIABLES IN COMMON /STAT/ (STATISTICS) :
!  IO  NRES  NUMBER OF RESTARTS.
!  IO  NDEC  NUMBER OF MATRIX DECOMPOSITION.
!  IO  NREM  NUMBER OF CONSTRAINT DELETIONS.
!  IO  NADD  NUMBER OF CONSTRAINT ADDITIONS.
!  IO  NIT  NUMBER OF ITERATIONS.
!  IO  NFV  NUMBER OF FUNCTION EVALUATIONS.
!  IO  NFG  NUMBER OF GRADIENT EVALUATIONS.
!  IO  NFH  NUMBER OF HESSIAN EVALUATIONS.
!
! SUBPROGRAMS USED :
!  S   PSQP  RECURSIVE QUADRATIC PROGRAMMING METHOD WITH THE BFGS
!         VARIABLE METRIC UPDATE.
!
! EXTERNAL SUBROUTINES :
!  SE  OBJ  COMPUTATION OF THE VALUE OF THE OBJECTIVE FUNCTION.
!         CALLING SEQUENCE: CALL OBJ(NF,X,FF) WHERE NF IS THE NUMBER
!         OF VARIABLES, X(NF) IS A VECTOR OF VARIABLES AND FF IS THE
!         VALUE OF THE OBJECTIVE FUNCTION.
!  SE  DOBJ  COMPUTATION OF THE GRADIENT OF THE OBJECTIVE FUNCTION.
!         CALLING SEQUENCE: CALL DOBJ(NF,X,GF) WHERE NF IS THE NUMBER
!         OF VARIABLES, X(NF) IS A VECTOR OF VARIABLES AND GC(NF) IS
!         THE GRADIENT OF THE OBJECTIVE FUNCTION.
!  SE  CON  COMPUTATION OF THE VALUE OF THE CONSTRAINT FUNCTION.
!         CALLING SEQUENCE: CALL CON(NF,KC,X,FC) WHERE NF IS THE
!         NUMBER OF VARIABLES, KC IS THE INDEX OF THE CONSTRAINT
!         FUNCTION, X(NF) IS A VECTOR OF VARIABLES AND FC IS THE
!         VALUE OF THE CONSTRAINT FUNCTION.
!  SE  DCON  COMPUTATION OF THE GRADIENT OF THE CONSTRAINT FUNCTION.
!         CALLING SEQUENCE: CALL DCON(NF,KC,X,GC) WHERE NF IS THE
!         NUMBER OF VARIABLES, KC IS THE INDEX OF THE CONSTRAINT
!         FUNCTION, X(NF) IS A VECTOR OF VARIABLES AND GC(NF) IS THE
!         GRADIENT OF THE CONSTRAINT FUNCTION.
!
SUBROUTINE PSQP_WRAP(NF,NC,X,IX,XL,XU,CF,IC,CL,CU, & 
     MIT,MFV,MET,MEC,XMAX,TOLX,TOLC,TOLG,RPF, &
     F,GMAX,CMAX,IPRNT,IOUT,IFILE,ITERM)
  !
  !     POINTERS FOR AUXILIARY ARRAYS
  !
  DOUBLE PRECISION XMAX,TOLX,TOLC,TOLG,RPF,F,CMAX,GMAX
  INTEGER          MIT,MFV,MET,MEC,IPRNT,IOUT,ITERM,NB,NC,NF
  CHARACTER*(*)    IFILE
  DOUBLE PRECISION CF(NC+1),CL(NC),CU(NC)
  DOUBLE PRECISION X(NF),XL(NF),XU(NF)
  INTEGER          IC(NC),IX(NF)
  INTEGER          NADD,NDEC,NFG,NFH,NFV,NIT,NREM,NRES
  INTEGER          LCFD,LCFO,LCG,LCP,LCR,LCZ,LG,LGC,LGF,LGO,LH,LIA,LS,LXO
  COMMON           /STAT/NRES,NDEC,NREM,NADD,NIT,NFV,NFG,NFH
  !
  !  ALLOCATE WORKING ARRAYS
  !
  INTEGER IA(:)
  DOUBLE PRECISION RA(:)
  ALLOCATABLE IA,RA
  ALLOCATE (IA(NF),RA((NF+NC+8)*NF+3*NC+1))
  LCG = 1
  LCFO = LCG + NF*NC
  LCFD = LCFO + NC + 1
  LGC = LCFD + NC
  LCR = LGC + NF
  LCZ = LCR + NF*(NF+1)/2
  LCP = LCZ + NF
  LGF = LCP + NC
  LG = LGF + NF
  LH = LG + NF
  LS = LH + NF* (NF+1)/2
  LXO = LS + NF
  LGO = LXO + NF
  LIA = 1
  !
  !  OPEN WRITE FILE
  !    
  IF (IPRNT.NE.0) THEN
     OPEN(UNIT=IOUT,FILE=IFILE,STATUS='UNKNOWN')
  END IF
  ! 
  !  CALL PSQP
  ! 
  NB = 1
  CALL PSQP(NF,NB,NC,X,IX,XL,XU,CF,IC,CL,CU,RA,RA(LCFO),RA(LCFD),&
            RA(LGC),IA,RA(LCR),RA(LCZ),RA(LCP),RA(LGF),RA(LG),&
            RA(LH),RA(LS),RA(LXO),RA(LGO),XMAX,TOLX,TOLC,&
            TOLG,RPF,CMAX,GMAX,F,MIT,MFV,MET,&
            MEC,IPRNT,IOUT,ITERM)
  !
  !  CLOSE WRITE FILE
  !
  IF (IPRNT.NE.0) THEN
     CLOSE(IOUT)
  END IF
  !
  !  DEALLOCATE WORKING ARRAYS
  !
  DEALLOCATE(IA,RA)
  !

END SUBROUTINE PSQP_WRAP

SUBROUTINE FUN(NF,KA,X,FA)
  INTEGER KA,NF
  DOUBLE PRECISION FA,X(*)
  KA=NF
  FA=X(1)

end SUBROUTINE FUN

SUBROUTINE DFUN(NF,KA,X,GA)
  INTEGER KA,NF
  DOUBLE PRECISION GA(*),X(*)
  KA=NF
  GA(1)=X(1)
end SUBROUTINE DFUN
